home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / mxcode / ampegsrc / encodsrc / decode.c < prev    next >
Text File  |  1994-01-04  |  24KB  |  739 lines

  1. nstrate the GetImage and PutImage commands }
  2.  
  3. const
  4.   r  = 20;
  5.   StartX = 100;
  6.   StartY = 50;
  7.  
  8. var
  9.   CurPort : ViewPortType;
  10.  
  11. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  12. var
  13.   Step : integer;
  14. begin
  15.   Step := Random(2*r);
  16.   if Odd(Step) then
  17.     Step := -Step;
  18.   X := X + Step;
  19.   Step := Random(r);
  20.   if Odd(Step) then
  21.     Step := -Step;
  22.   Y := Y + Step;
  23.  
  24.   { Make saucer bounce off viewport walls }
  25.   with CurPort do
  26.   begin
  27.     if (x1 + X + Width - 1 > x2) then
  28.       X := x2-x1 - Width + 1
  29.     else
  30.       if (X < 0) then
  31.         X := 0;
  32.     if (y1 + Y + Height - 1 > y2) then
  33.       Y := y2-y1 - Height + 1
  34.     else
  35.       if (Y < 0) then
  36.         Y := 0;
  37.   end;
  38. end; { MoveSaucer }
  39.  
  40. var
  41.   Pausetime : word;
  42.   Saucer    : pointer;
  43.   X, Y      : integer;
  44.   ulx, uly  : word;
  45.   lrx, lry  : word;
  46.   Size      : word;
  47.   I         : word;
  48. begin
  49.   ClearDevice;
  50.   FullPort;
  51.  
  52.   { PaintScreen }
  53.   ClearDevice;
  54.   MainWindow('GetImage / PutImage Demonstration');
  55.   StatusLine('Esc aborts or press a key...');
  56.   GetViewSettings(CurPort);
  57.  
  58.   { DrawSaucer }
  59.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  60.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  61.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  62.   Circle(StartX+10, StartY-12, 2);
  63.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  64.   Circle(StartX-10, StartY-12, 2);
  65.   SetFillStyle(SolidFill, MaxColor);
  66.   FloodFill(StartX+1, StartY+4, GetColor);
  67.  
  68.   { ReadSaucerImage }
  69.   ulx := StartX-(r+1);
  70.   uly := StartY-14;
  71.   lrx := StartX+(r+1);
  72.   lry := StartY+(r div 3)+3;
  73.  
  74.   Size := ImageSize(ulx, uly, lrx, lry);
  75.   GetMem(Saucer, Size);
  76.   GetImage(ulx, uly, lrx, lry, Saucer^);
  77. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  78.  
  79.   { Plot some "stars" }
  80.   for I := 1 to 1000 do
  81.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  82.   X := MaxX div 2;
  83.   Y := MaxY div 2;
  84.   PauseTime := 70;
  85.  
  86.   { Move the saucer around }
  87.   repeat
  88. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  89.      Delay(PauseTime);
  90. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  91.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  92.   until KeyPressed;
  93.   FreeMem(Saucer, size);
  94.   WaitToGo;
  95. end; { PutImagePlay }
  96.  
  97. procedure PolyPlay;
  98. { Draw random polygons with random fill styles on the screen }
  99. const
  100.   MaxPts = 5;
  101. type
  102.   PolygonType = array[1..MaxPts] of PointType;
  103. var
  104.   Poly : PolygonType;
  105.   I, Color : word;
  106. begin
  107.   MainWindow('FillPoly demonstration');
  108.   StatusLine('Esc aborts or press a key...');
  109.   repeat
  110.     Color := RandColor;
  111.     SetFillStyle(Random(11)+1, Color);
  112.     SetColor(Color);
  113.     for I := 1 to MaxPts do
  114.       with Poly[I] do
  115.       begin
  116.         X := Random(MaxX);
  117.         Y := Random(MaxY);
  118.       end;
  119.     FillPoly(MaxPts, Poly);
  120.   until KeyPressed;
  121.   WaitToGo;
  122. end; { PolyPlay }
  123.  
  124. procedure FillStylePlay;
  125. { Display all of the predefined fill styles available }
  126. var
  127.   Style    : word;
  128.   Width    : word;
  129.   Height   : word;
  130.   X, Y     : word;
  131.   I, J     : word;
  132.   ViewInfo : ViewPortType;
  133.  
  134. procedure DrawBox(X, Y : word);
  135. begin
  136.   SetFillStyle(Style, MaxColor);
  137.   with ViewInfo do
  138.     Bar(X, Y, X+Width, Y+Height);
  139.   Rectangle(X, Y, X+Width, Y+Height);
  140.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  141.   Inc(Style);
  142. end; { DrawBox }
  143.  
  144. begin
  145.   MainWindow('Pre-defined fill styles');
  146.   GetViewSettings(ViewInfo);
  147.   with ViewInfo do
  148.   begin
  149.     Width := 2 * ((x2+1) div 13);
  150.     Height := 2 * ((y2-10) div 10);
  151.   end;
  152.   X := Width div 2;
  153.   Y := Height div 2;
  154.   Style := 0;
  155.   for J := 1 to 3 do
  156.   begin
  157.     for I := 1 to 4 do
  158.     begin
  159.       DrawBox(X, Y);
  160.       Inc(X, (Width div 2) * 3);
  161.     end;
  162.     X := Width div 2;
  163.     Inc(Y, (Height div 2) * 3);
  164.   end;
  165.   SetTextJustify(LeftText, TopText);
  166.   WaitToGo;
  167. end; { FillStylePlay }
  168.  
  169. procedure FillPatternPlay;
  170. { Display some user defined fill patterns }
  171. const
  172.   Patterns : array[0..11] of FillPatternType = (
  173.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****DDDDDDDU¬U¬U¬U¬U¬U¬U¬▌w▌w▌w▌w▌w▌w▌w°°°≥■°°≥≥■≥≥■■°°°    ≤  ≤  ≤≤         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       ;DDD;    $"Bdÿ>@@@>||>Ac]AAA1N"A""2,  `1NA"*III*<Bü üB<<BüüüB<A" \"QIE" < <BBBB  @@    ~ ?  @ÇB$$B ""A$$"AII6 üBr»$**IIII**ccregion.  The region is defined as any pixel of
  174.             OldColor which has a path of pixels of OldColor or NewColor
  175.             with sides touching back to the seed point, (XSeed, YSeed).
  176.             Therefore, only pixels of OldColor are modified and no other
  177.             information is changed.
  178.  
  179.             SEE ALSO
  180.  
  181.             DRWFILLBOX, DRWFILLCIRCLE, DRWFILLELLIPSE, FILLAREA,
  182.             FILLCONVEXPOLY, FILLPAGE, FILLPOLY, FILLSCREEN, FILLVIEW,
  183.             SETVIEW
  184.  
  185.             EXAMPL(HNxHHO$B<BBBB<$<BBBB<<BBBB<$BBBBBF:0BBBBF:$BBBF:B<""AAA""AAAAA"<B@@B<" <2\A">>xDDxDNDD <` <>BB= > <BBBB< BBBBF:2L\bBBBB&AaQIECA8$>""">0@@A>@@@ b$(. b$(*
  186.     $    $    $DDDDDDD¬U¬U¬U¬U¬U¬U¬Uw▌w▌w▌w▌w▌w▌w▌°°°⌠ⁿ°°⌠⌠ⁿ⌠⌠ⁿⁿ°°°    ≈  ≈  ≈≈         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@Ç>P>III>"AA""AAA"Uw<DDDD86II6"EIQ"\ @@ "AAAAA> >     hH02L2L$$<H(,$<>>>>>>>         VMODE=VIDEOMODEGET
  187.             IF WHICHVGA = 0 THEN STOP
  188.             DUMMY=RES640
  189.             SETVIEW 100, 100, 539, 379
  190.             FILLVIEW 10
  191.             WHILE INKEY$ = ""
  192.             WEND
  193.             VIDEOMODESET VMODE
  194.             END
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.                                                                          63
  212.  
  213.  
  214.  
  215.  
  216.  
  217.           FONTGETINFO
  218.  
  219.             PROTOTYPE
  220.  
  221.             SUB FONTGETINFO (Width%, Height%)
  222.  
  223.             INPUT
  224.  
  225.             no input parameters
  226.     WEND
  227.             MOUSEEXIT
  228.             VIDEOMODESET VMODE
  229.             END
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.                                                                          86
  271.  
  272.  
  273.  
  274.  
  275.  
  276.           MOUSECURSORDEFAULT
  277.  
  278.             PROTOTYPE
  279.  
  280.             SUB MOUSECURSORDEFAULT ()
  281.  
  282.             INPUT
  283.  
  284.             no input parameters
  285.  
  286.             OUTPUT
  287.  
  288.             no value returned
  289.  
  290.             USAGE
  291.  
  292.             MOUSECURSORDEFAULT defines the mouse cursor to be a small
  293.        ,K$╖┼╘╤░XQ)σ┤ö≡÷┴─┤àñT┘,╘¬àñX9╘⌠àñ\9╘UÜ╢≤`9╘4a╘d9╘UTa╘h9╘ta╘l9╘Uöa╘p9╘┤a╘t┘PT±x┴îÇ╖0▓ïα│ÅαU┤ôα╡ùα╢¢α╖úΓ╘pǺΓ╕¡αë ╚┴πì°sKÉφb<$⌡▌ë     φë φë I1φë  Eφë $YφÆë (mφë ,üφë 0$òφë á⌐φë ñ╜φë I¿╤φë ¼σφë ░∙φÆë 4²ë ┤!²ë ╕$5²ë ╝I²ë └]²ë ⌐8q²ë <àⁿΦiǬ∙PÖÇ ¥Ç
  294. ⁿ░╨â@%8@ΓΦá╝╤░≡cÑÅ*$░╕≡ż≡τ╥m¿⌡ε    ╨@#µ≈$âh$âαra╨à`¥è∩Ç%Ç +─▀ TîcOî∩â°1<@  [$¿Ç¼ MMl·0ƒ Y¼─!%6a▐è ¥ì ßá+?±  P<îaTTV ╪iÇ¡≥░ `_ñ»%Çá᪠P█º»ε`éa∙É%H«┴íA%Gár∙É
  295. iw∙Éiφ`╧≥≡╤Çmⁿ▒
  296. ]ÆAáσw7░⌡∩    $·╟Ç√É&^`  ┐ $ⁿ  $■ $╒ nk$J-ÉQ1£PéBù »0αQ/Ñ4╜£░ºP≈Ñ4Ç⌡$(ª▀$@C]Æé≈└╕_SÇçÑ4=iÉ⌠ä╣<_np@Ñ45ò▒Y3ü¼Qí░.i>╠@5+┴╙É╛╙$@ #┴@«╦
  297. $╤
  298. #@Ñú4,p&e÷ü¼_ÇQºÑ4òQ  ü@;¡_áQ@e╠≥@mp!┤a╘O░√`Pñź ÇT°8ÿ!¼Åñ$½╙"q¿ PñCÇ¿α√└╥░eT"ß<p°%Pæ(╧%pδ¥/OêW0Ǽbφ φ B@[â¼8â≥µ≤(    ¿⌡%(Ç∩áTÿp+ óÜ▓0!Σ±(1±░┤ÖÇD└D0Å╡`   $ «îO@╧1
  299. a╝╤j-0ñ│`@╖bΦaT1═⌠╝╤Σ²¼±,1öíî9lÿ28ÇÅ`Γî¿P²$,N0┴O0a╫δ≤0σú`°î╖#0δ≡└X▄1»Σî(▒¥Ç█Ñ"qá√1CÇú╟╨º Å
  300. FT Θ²î└1ÇY0    w ²à░$@AÅ`╦Φ¼╘`▄1A  }┐Ç*5 ΩSδδî`¼îaδæ¼î5 1¿⌡Ω╜⌠ ¼¥╬ü└Qî1S╛≤î9╨iÇ,∙PU(}Ç$üÇ àÇ`σìÇ`QαÜBO$%ÿÇ╧"$Ç«Ç]É.┬\`%WÉ$  W0 ÄâO0]αG┬ur╩░£▒Q¢ú╔Ç≡°s?`X0╘`@ µWâ@╣aá εdq`¥9?Ç&+o0µyÄΣAÅuV(7P╬±@IdQ╕@Å┤@;Ç▓?Çò│CÇ┤╟╨╡KÇÄ30ⁿφ° ó╬ì+]Ä╦≡     Mö╝σ ²y5<!└▀óâ╝É3~mp    $<╛≤9Æ-2ⁿ≡@T,╞Σa,)Pæ└¥#¼╪Q┤S(¼@Aîa≡╤@Ö²±⌠KëD─┴▒▀0╨Ñ$╩-0 ╨ê*╙▓edm`î=3Kß-10è=≥≤²└£mîjy ÿe²ⁿ╨i╕e▓ΣmαÖ╢C%Ç*ê*0 EátQZ`mÄLP%    °üⁿªüNQ∙  T¿<qtWΩc z░ÅÇñΩçǪçÇ«;└<┐á¼¥. á?<Σscî)áí := 0;
  301.       end;
  302.     end;
  303.   end;
  304.   WaitToGo;
  305. end; { UserLineStylePlay }
  306.  
  307.  
  308. procedure SayGoodbye;
  309. { Say goodbye and then exit the program }
  310. var
  311.   ViewInfo : ViewPortType;
  312. begin
  313.   MainWindow('');
  314.   GetViewSettings(ViewInfo);
  315.   SetTextStyle(TriplexFont, HorizDir, 4);
  316.   SetTextJustify(CenterText, CenterText);
  317.   with ViewInfo do
  318.     OutTextXY((x2-x1) div 2, (y2-y1) div 2, 'That''s all folks!');
  319.   StatusLine('Press any key to quit...');
  320.   repeat until KeyPressed;
  321. end; { SayGoodbye }
  322.  
  323.  
  324. PROCEDURE SelectMode;
  325. VAR
  326.     choice1,choice2     : CHAR;
  327.    xsize,ysize            : WORD;
  328. BEGIN
  329.     (* Let's select a mode *)
  330.     ClrScr;
  331.     WriteLn('VESADEMO:');
  332.     WriteLn('1. 256 colors');
  333.     WriteLn('2. 32768 colors');
  334.     WriteLn('3. 65536 colors');
  335.     WriteLn('4. 16777216 colors');
  336.     WriteLn('Q uit');
  337.     WriteLn;
  338.     Write('Your choice: ');
  339.     REPEAT
  340.         ReadLn(choice1);
  341.       IF choice1 <> '1' THEN BEGIN
  342.           WriteLn('Sorry !');
  343.          WriteLn('This demo wasn''t written for more as 256 colors !');
  344.          WriteLn('You would only get a limited impression of the Hi-& TrueColor modes...');
  345.          WriteLn('Switching to 256 colors.');
  346.          choice1 := '1';
  347.       END;
  348.     UNTIL choice1 IN ['1'..'4','q'];
  349.     IF choice1 = 'q' THEN Halt;
  350.  
  351.     WriteLn;
  352.     WriteLn;
  353.     WriteLn('a. 320x200');
  354.     WriteLn('b. 640x480');
  355.     WriteLn('c. 800x600');
  356.     WriteLn('d. 1024x768');
  357.     WriteLn('e. 1280x1024');
  358.     WriteLn('Q uit');
  359.     WriteLn;
  360.     Write('Your choice: ');
  361.     REPEAT
  362.         ReadLn(choice2);
  363.     UNTIL choice2 IN ['a'..'e','q'];
  364.     IF choice2 = 'q' THEN Halt;
  365.  
  366.     CASE choice2 OF
  367.         'a' : BEGIN
  368.             xsize := 320;
  369.             ysize := 200;
  370.         END;
  371.         'b' : BEGIN
  372.             xsize := 640;
  373.             ysize := 480;
  374.         END;
  375.         'c' : BEGIN
  376.             xsize := 800;
  377.             ysize := 600;
  378.         END;
  379.         'd' : BEGIN
  380.             xsize := 1024;
  381.             ysize := 768;
  382.         END;
  383.         'e' : BEGIN
  384.             xsize := 1280;
  385.             ysize := 1024;
  386.         END;
  387.     END;
  388.     CASE choice1 OF
  389.         '1' : mode := FindVesaMode(xsize,ysize,8);
  390.         '2' : mode := FindVesaMode(xsize,ysize,15);
  391.         '3' : mode := FindVesaMode(xsize,ysize,16);
  392.         '4' : mode := FindVesaMode(xsize,ysize,24);
  393.     END;
  394.     IF mode = 0 THEN BEGIN
  395.         WriteLn('No such mode could be found !');
  396.         WriteLn('Switching to to 320x200.');
  397.         ReadKey;
  398.         mode := V320x200x256;
  399.     END;
  400. END;
  401.  
  402. begin { program body }
  403.   SelectMode;
  404.   Initialize;
  405.   ReportStatus;
  406.  
  407. {  AspectRatioPlay; }
  408.   FillEllipsePlay;
  409.   SectorPlay;
  410.   WriteModePlay;
  411.  
  412.   ColorPlay;
  413.   { PalettePlay only intended to work on these drivers: }
  414.   if (GraphDriver = EGA) or
  415.       (GraphDriver = EGA64) or
  416.       (GraphDriver = VGA) then
  417.      PalettePlay;
  418.   PutPixelPlay;
  419. {  PutImagePlay; }
  420.   RandBarPlay;
  421.   BarPlay;
  422.   Bar3DPlay;
  423.   ArcPlay;
  424.   CirclePlay;
  425.   PiePlay;
  426.   LineToPlay;
  427.   LineRelPlay;
  428. {  LineStylePlay; }
  429. {  UserLineStylePlay; }
  430.   TextDump;
  431.   TextPlay;
  432.   CrtModePlay;
  433.   FillStylePlay;
  434.   FillPatternPlay;
  435.   PolyPlay;
  436.   SayGoodbye;
  437. {  CloseGraph; }
  438.   CloseVesa;
  439. end.
  440. ***************************************************
  441.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  442.     '****************************************************************∞╥≤c≤*φè#^│v/╒:j═φ0t+l▓ô"¬"g└≡?%ªêΣ│H╫½╫╜├¿U'╒⌐⌡ ßV?╩¬ujOΦçEZ1∞▐! ▄B╛Σ8║æ]1GlNÜ┐q▌▓;ô$ΦzE<cª*bEô#ä╧ñÅ"∩─LrdaÖ ╠º╫a^¥£å╬1~)@ëÖMδ╫0═6DäFê¬Çv┼ß╨kæpτ╪É)}ª 1w3╤╧ü⌡¥╓h▓╣≈ïÅaÑ[TⁿHqªÉ╝DKÄ─Y-∞tT╤Θ╨º╟╪.*ÇI9lΦ≈{πτcσ$τπßoFr╪╨∩┼╞╟;O2■e²LÜ4^N|╪½ÅO?╔°FOz`╟╟╟'<>>π$πΘù6·Xgî╖│°oîδπGƒd╝▀░?■╪╔_9L ⌡ôⁿq'æO▀ƒn4╔▀╚▄┼3pτ.òO°·}÷╕ⁿ±'æO?ít│!√8ßÑ≤/┐╣p┼≥┘E╦Vox╕cΦé5╟╚º╙$?√$≥ΘZεsî≡åìΓpKù¢ïß X╥ 9╞≈\µk┤O¥_ 5Üö\≤éÄ┌╤A[╤ÿáï┼éNⁿÅu16    g,%hc╙╨cD╨Vï┘R¢öKñR;8εáΣ╢╪ós╤π╡á└èxgzPÄMú╫yαºÉ+σJ¢i+▓â3╥    ═Ñ╙î^ºG▓█πérφçs %#(╗⌠?┼%u8≡6+QÉ))ò)Afw≈╣╪)B&4░åLXV:δät@Å.;5Φf╢Ät┐ΣJ╫─U8úÇ╟éö£╕p╔┴⌠vg╨╬╥é÷╪╣┬ΓI.ç≡^v╤ZΦÇ& ╒┌6ñô6XßNè╡╬E₧Ñ
  443. kIº╠▄A+╣╥éb²tæ-Y¡½αÑa═uuîÇ╢αêvhuª╡SÅ┤vèùú¥F;p<d⌐/F─d█éT%▓KΦû=q■öI┐ ┐╠6S$▒÷╚ENΩ¥Fû9╔┌R'╝ ╧φ└?g┬j▓0═/b╖₧─mûé╢┌»ÿÄë/·<éò■░╤╟╢├Xσ:╥P3Θ"╬Læsφ░┌öSö!╗¿*mN£WΣÇ£┤~#╗ææ≥RΩóh:à▌.æ≈╕▌v£äàd▒à╒├=░╖π║$howeg*╬    6ù▄ƒô╕φ░Ö╢qΘD>(w@úKεHÆ╛öúΣU
  444. éÜR╔╤W▄èê 2M%ó.▓SNÖA1ùJE╢║l]▓¿>\%└Å4ßO▄£â⌐& ê/)8vSP▀▓ôⁿææ√ü√ÑÄa⌠â╚4S╓╟P- ?Σá╕▓Næ*q╡UΘ▓≈^ñ·I.rúR&$Y^╚%è≡B┌≈Ceat
  445.     Color := RandColor;
  446.     SetColor(Color);
  447.     SetFillStyle(Random(CloseDotFill)+1, Color);
  448.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  449.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  450.   until KeyPressed;
  451.   WaitToGo;
  452. end; { RandBarPlay }
  453.  
  454. procedure ArcPlay;
  455. { Draw random arcs on the screen }
  456. var
  457.   MaxRadius : word;
  458.   EndAngle : word;
  459.   ArcInfo : ArcCoordsType;
  460. begin
  461.   MainWindow('Arc / GetArcCoords demonstration');
  462.   StatusLine('Esc aborts or press a key');
  463.   MaxRadius := MaxY div 10;
  464.   repeat
  465.     SetColor(RandColor);
  466.     EndAngle := Random(360);
  467.     SetLineStyle(SolidLn, 0, NormWidth);
  468.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  469.     GetArcCoords(ArcInfo);
  470.     with ArcInfo do
  471.     begin
  472.       Line(X, Y, XStart, YStart);
  473.       Line(X, Y, Xend, Yend);
  474.     end;
  475.   until KeyPressed;
  476.   WaitToGo;
  477. end; { ArcPlay }
  478.  
  479. procedure PutPixelPlay;
  480. { Demonstrate the PutPixel and GetPixel commands }
  481. const
  482.   Seed   = 1962; { A seed for the random number generator }
  483.   NumPts = 2000; { The number of pixels plotted }
  484.   Esc    = #27;
  485. var
  486.   I : word;
  487.   X, Y, Color : word;
  488.   XMax, YMax  : integer;
  489.   ViewInfo    : ViewPortType;
  490. begin
  491.   MainWindow('PutPixel / GetPixel demonstration');
  492.   StatusLine('Esc aborts or press a key...');
  493.  
  494.   GetViewSettings(ViewInfo);
  495.   with ViewInfo do
  496.   begin
  497.     XMax := (x2-x1-1);
  498.     YMax := (y2-y1-1);
  499.   end;
  500.  
  501.   while not KeyPressed do
  502.   begin
  503.     { Plot random pixels }
  504.     RandSeed := Seed;
  505.     I := 0;
  506.     while (not KeyPressed) and (I < NumPts) do
  507.     begin
  508.       Inc(I);
  509.         PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  510.     end;
  511.  
  512.     { Erase pixels }
  513.     RandSeed := Seed;
  514.     I := 0;
  515.     while (not KeyPressed) and (I < NumPts) do
  516.     begin
  517.       Inc(I);
  518.       X := Random(XMax)+1;
  519.       Y := Random(YMax)+1;
  520.       Color := GetPixel(X, Y);
  521.         if Color = RandColor then
  522.           PutPixel(X, Y, 0);
  523.      end;
  524.   end;
  525.   WaitToGo;
  526. end; { PutPixelPlay }
  527.  
  528. procedure PutImagePlay;
  529. { Demonstrate the GetImage and PutImage commands }
  530.  
  531. const
  532.   r  = 20;
  533.   StartX = 100;
  534.   StartY = 50;
  535.  
  536. var
  537.   CurPort : ViewPortType;
  538.  
  539. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  540. var
  541.   Step : integer;
  542. begin
  543.   Step := Random(2*r);
  544.   if Odd(Step) then
  545.     Step := -Step;
  546.   X := X + Step;
  547.   Step := Random(r);
  548.   if Odd(Step) then
  549.     Step := -Step;
  550.   Y := Y + Step;
  551.  
  552.   { Make saucer bounce off viewport walls }
  553.   with CurPort do
  554.   begin
  555.     if (x1 + X + Width - 1 > x2) then
  556.       X := x2-x1 - Width + 1
  557.     else
  558.       if (X < 0) then
  559.         X := 0;
  560.     if (y1 + Y + Height - 1 > y2) then
  561.       Y := y2-y1 - Height + 1
  562.     else
  563.       if (Y < 0) then
  564.         Y := 0;
  565.   end;
  566. end; { MoveSaucer }
  567.  
  568. var
  569.   Pausetime : word;
  570.   Saucer    : pointer;
  571.   X, Y      : integer;
  572.   ulx, uly  : word;
  573.   lrx, lry  : word;
  574.   Size      : word;
  575.   I         : word;
  576. begin
  577.   ClearDevice;
  578.   FullPort;
  579.  
  580.   { PaintScreen }
  581.   ClearDevice;
  582.   MainWindow('GetImage / PutImage Demonstration');
  583.   StatusLine('Esc aborts or press a key...');
  584.   GetViewSettings(CurPort);
  585.  
  586.   { DrawSaucer }
  587.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  588.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  589.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  590.   Circle(StartX+10, StartY-12, 2);
  591.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  592.   Circle(StartX-10, StartY-12, 2);
  593.   SetFillStyle(SolidFill, MaxColor);
  594.   FloodFill(StartX+1, StartY+4, GetColor);
  595.  
  596.   { ReadSaucerImage }
  597.   ulx := StartX-(r+1);
  598.   uly := StartY-14;
  599.   lrx := StartX+(r+1);
  600.   lry := StartY+(r div 3)+3;
  601.  
  602.   Size := ImageSize(ulx, uly, lrx, lry);
  603.   GetMem(Saucer, Size);
  604.   GetImage(ulx, uly, lrx, lry, Saucer^);
  605. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  606.  
  607.   { Plot some "stars" }
  608.   for I := 1 to 1000 do
  609.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  610.   X := MaxX div 2;
  611.   Y := MaxY div 2;
  612.   PauseTime := 70;
  613.  
  614.   { Move the saucer around }
  615.   repeat
  616. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  617.      Delay(PauseTime);
  618. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  619.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  620.   until KeyPressed;
  621.   FreeMem(Saucer, size);
  622.   WaitToGo;
  623. end; { PutImagePlay }
  624.  
  625. procedure PolyPlay;
  626. { Draw random polygons with random fill styles on the screen }
  627. const
  628.   MaxPts = 5;
  629. type
  630.   PolygonType = array[1..MaxPts] of PointType;
  631. var
  632.   Poly : PolygonType;
  633.   I, Color : word;
  634. begin
  635.   MainWindow('FillPoly demonstration');
  636.   StatusLine('Esc aborts or press a key...');
  637.   repeat
  638.     Color := RandColor;
  639.     SetFillStyle(Random(11)+1, Color);
  640.     SetColor(Color);
  641.     for I := 1 to MaxPts do
  642.       with Poly[I] do
  643.       begin
  644.         X := Random(MaxX);
  645.         Y := Random(MaxY);
  646.       end;
  647.     FillPoly(MaxPts, Poly);
  648.   until KeyPressed;
  649.   WaitToGo;
  650. end; { PolyPlay }
  651.  
  652. procedure FillStylePlay;
  653. { Display all of the predefined fill styles available }
  654. var
  655.   Style    : word;
  656.   Width    : word;
  657.   Height   : word;
  658.   X, Y     : word;
  659.   I, J     : word;
  660.   ViewInfo : ViewPortType;
  661.  
  662. procedure DrawBox(X, Y : word);
  663. begin
  664.   SetFillStyle(Style, MaxColor);
  665.   with ViewInfo do
  666.     Bar(X, Y, X+Width, Y+Height);
  667.   Rectangle(X, Y, X+Width, Y+Height);
  668.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  669.   Inc(Style);
  670. end; { DrawBox }
  671.  
  672. begin
  673.   MainWindow('Pre-defined fill styles');
  674.   GetViewSettings(ViewInfo);
  675.   with ViewInfo do
  676.   begin
  677.     Width := 2 * ((x2+1) div 13);
  678.     Height := 2 * ((y2-10) div 10);
  679.   end;
  680.   X := Width div 2;
  681.   Y := Height div 2;
  682.   Style := 0;
  683.   for J := 1 to 3 do
  684.   begin
  685.     for I := 1 to 4 do
  686.     begin
  687.       DrawBox(X, Y);
  688.       Inc(X, (Width div 2) * 3);
  689.     end;
  690.     X := Width div 2;
  691.     Inc(Y, (Height div 2) * 3);
  692.   end;
  693.   SetTextJustify(LeftText, TopText);
  694.   WaitToGo;
  695. end; { FillStylePlay }
  696.  
  697. procedure FillPatternPlay;
  698. { Display some user defined fill patterns }
  699. const
  700.   Patterns : array[0..11] of FillPatternType = (
  701.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****DDDDDDDU¬U¬U¬U¬U¬U¬U¬▌w▌w▌w▌w▌w▌w▌w°°°≥■°°≥≥■≥≥■■°°°    ≤  ≤  ≤≤         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       ;DDD;    $"Bdÿ>@@@>||>Ac]AAA1N"A""2,  `1NA"*III*<Bü üB<<BüüüB<A" \"QIE" < <BBBB  @@    ~ ?  @ÇB$$B ""A$$"AII6 üBr»$**IIII**ccregion.  The region is defined as any pixel of
  702.             OldColor which has a path of pixels of OldColor or NewColor
  703.             with sides touching back to the seed point, (XSeed, YSeed).
  704.             Therefore, only pixels of OldColor are modified and no other
  705.             information is changed.
  706.  
  707.             SEE ALSO
  708.  
  709.             DRWFILLBOX, DRWFILLCIRCLE, DRWFILLELLIPSE, FILLAREA,
  710.             FILLCONVEXPOLY, FILLPAGE, FILLPOLY, FILLSCREEN, FILLVIEW,
  711.             SETVIEW
  712.  
  713.             EXAMPL(HNxHHO$B<BBBB<$<BBBB<<BBBB<$BBBBBF:0BBBBF:$BBBF:B<""AAA""AAAAA"<B@@B<" <2\A">>xDDxDNDD <` <>BB= > <BBBB< BBBBF:2L\bBBBB&AaQIECA8$>""">0@@A>@@@ b$(. b$(*
  714.     $    $    $DDDDDDD¬U¬U¬U¬U¬U¬U¬Uw▌w▌w▌w▌w▌w▌w▌°°°⌠ⁿ°°⌠⌠ⁿ⌠⌠ⁿⁿ°°°    ≈  ≈  ≈≈         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       7HH7"B\DBBRL~BB@@@@@@?R~!!~?DDDD8BBBB|@@Ç>P>III>"AA""AAA"Uw<DDDD86II6"EIQ"\ @@ "AAAAA> >     hH02L2L$$<H(,$<>>>>>>>         VMODE=VIDEOMODEGET
  715.             IF WHICHVGA = 0 THEN STOP
  716.             DUMMY=RES640
  717.             SETVIEW 100, 100, 539, 379
  718.             FILLVIEW 10
  719.             WHILE INKEY$ = ""
  720.             WEND
  721.             VIDEOMODESET VMODE
  722.             END
  723.  
  724.  
  725.  
  726.  
  727.  
  728.  
  729.  
  730.  
  731.  
  732.  
  733.  
  734.  
  735.  
  736.  
  737.  
  738.  
  739.